home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / intern2a / module1.bas < prev    next >
BASIC Source File  |  1999-10-09  |  2KB  |  61 lines
  1. Attribute VB_Name = "Module1"
  2. '********************************************************
  3. '
  4. 'This Module is all you need to check (via RAS) if you
  5. 'are currently Online
  6. '
  7. 'IsRASConnected() returns True if you are connected.
  8. 'Otherwise, it returns False.
  9. '
  10. '********************************************************
  11.  
  12. Private Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
  13. Private Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasConn As Long, lpRASCONNSTATUS As Any) As Long
  14.  
  15. Private Const RAS95_MaxEntryName = 256
  16. Private Const RAS_MaxDeviceType = 16
  17. Private Const RAS95_MaxDeviceName = 128
  18. Private Const RASCS_DONE = &H2000&
  19.  
  20. Type RASCONN95
  21.     dwSize As Long
  22.     hRasConn As Long
  23.     szEntryName(RAS95_MaxEntryName) As Byte
  24.     szDeviceType(RAS_MaxDeviceType) As Byte
  25.     szDeviceName(RAS95_MaxDeviceName) As Byte
  26. End Type
  27.  
  28. Type RASCONNSTATUS95
  29.     dwSize As Long
  30.     RasConnState As Long
  31.     dwError As Long
  32.     szDeviceType(RAS_MaxDeviceType) As Byte
  33.     szDeviceName(RAS95_MaxDeviceName) As Byte
  34. End Type
  35.  
  36. Public Function IsRASConnected() As Boolean
  37.     Dim TRasCon(255) As RASCONN95
  38.     Dim lg As Long
  39.     Dim lpcon As Long
  40.     Dim lReturn As Long
  41.     Dim Tstatus As RASCONNSTATUS95
  42.     
  43.     TRasCon(0).dwSize = 412
  44.     lg = 256 * TRasCon(0).dwSize
  45.     lReturn = RasEnumConnections(TRasCon(0), lg, lpcon)
  46.     
  47.     If lReturn Then
  48.         MsgBox "O m≤dulo de detecτπo de ligaτπo nπo estß a funcionar." & vbCrLf & "Contacte o seu administrador do sistema", vbApplicationModal + vbCritical, "Erro"
  49.         Exit Function
  50.     End If
  51.     
  52.     Tstatus.dwSize = 160
  53.     lReturn = RasGetConnectStatus(TRasCon(0).hRasConn, Tstatus)
  54.     
  55.     If Tstatus.RasConnState = RASCS_DONE Then
  56.         IsRASConnected = True
  57.     Else
  58.         IsRASConnected = False
  59.     End If
  60. End Function
  61.